
finp2$="picture.png"

shell("convert "+finp2$+" -resize 320x200\\! _tmpr2.jpg")
finp$="_tmpr2.jpg"


'finp$="screenshot.png"
dim cr[40,25,16],mt[40,25],cmu[16],ag[40,25,4],iklv[16],kv[4],colourid[16],colourid2[16],pke[16384]

'Set Buffer 100
'Dim CR(40,25,16),MT(40,25),CMU(16),AG(40,25,4),IKLV(16),KV(4)
'Reserve As Work 4,20000

' cr[,,] - n� pixels de cada cor em cada atributo
' mt[,]  - n� de cores em cada atributo
' cmu[]  - n� de atributos c/ 4 cores ou mais que cada cor pertence
' cnt    - cor mais usada em atributos c/ 4 cores ou mais
' asg[,,]- atributos 


xed=640:yed=400:wdwd=1
setdisplay(xed,yed,32,wdwd)
paper(0xFFFFFF):ink(0):cls

'Screen Open 0,640,480,16,32772 : Curs Off : Flash Off : Cls 

colourid[0]=0x000:colourid[1]=0xFFF:colourid[2]=0x931:colourid[3]=0x5BD
colourid[4]=0x93C:colourid[5]=0x4A1:colourid[6]=0x32C:colourid[7]=0xBD3
colourid[8]=0x950:colourid[9]=0x440:colourid[10]=0xC64:colourid[11]=0x444
colourid[12]=0x777:colourid[13]=0x8E5:colourid[14]=0x75F:colourid[15]=0x999

for i=0 to 15
  u=colourid[i]
  rlv=(int(u/256))
  glv=bitwiseand((int(u/16)),15)
  blv=bitwiseand(u,15)
  iklv[i]=((blv*11)+(glv*59)+(rlv*30))/15
  next
for i=0 to 15
  u=colourid[i]
  rlv=(int(u/256))
  glv=bitwiseand((int(u/16)),15)
  blv=bitwiseand(u,15)
  colourid2[i]=(int((rlv/15)*255))*65536+(int((glv/15)*255))*256+(int((blv/15)*255))
  next

'Restore DPAL
'  for I=0 to 15 : Read U : Colour I,U
'    RLV=(Int(U/256)):GLV=((Int(U/16)) and 15):BLV=(U and 15)
'    KLV=((BLV*11)+(GLV*59)+(RLV*30))/15: IKLV(I)=KLV
'  Next I
'DPAL:
'  Data $0,$FFF,$931,$5BD,$93C,$4A1,$32C,$BD3,$950,$440,$C64,$444,$777,$8E5,$75F,$999

loadimage(finp$,1):pasteicon(0,0,1)

'Cls 15 : Pen 2 : Paper 15
'  Load Iff Fsel$('','',''),1 : Screen 1 : Screen Hide 1
'  Screen Copy 1,0,0,320,200 to 0,0,0
'  Screen 0

' ----- step 1
' ----- counts ammount of pixels from each colour from each attribute 
for y1=0 to 24
  setcaption("step 1: "+str$(y1)+"/24")
  'Locate 41,51 : Print "passo  1 - ";Y1;"/24     "
  for x1=0 to 39
    for y2=0 to 7
      for x2=0 to 3
        x=x2+(X1*4)
        y=y2+(y1*8)

        '????? bug below
        'u=point(x*2,y)

        u2=point(x*2,y)
        u=0:dis=1000
        for i=0 to 15
          qq=colourid[i]
          blv=qq mod 16:qq=int(qq/16)
          glv=qq mod 16:qq=int(qq/16)
          rlv=qq mod 16
          qq=u2
          blv2=int(qq/16) mod 16:qq=int(qq/256)
          glv2=int(qq/16) mod 16:qq=int(qq/256)
          rlv2=int(qq/16) mod 16
          bdist=abs(blv-blv2)
          gdist=abs(glv-glv2)
          rdist=abs(rlv-rlv2)
          rgbdist=sqr((rdist^2)+(gdist^2)+(bdist^2))
          if rgbdist<dis then:dis=rgbdist:u=i:end if
          next

        cr[x1,y1,u]=cr[x1,y1,u]+1
        next:next
    next:next

' ----- step 2
' ----- counts ammount of colours in each attribute
for y1=0 to 24
  'Locate 41,51 : Print "passo  2 - ";Y1;"/24     "
  setcaption("step 2: "+str$(y1)+"/24")
  for x1=0 to 39
    es=0
    for e=0 to 15
      if cr[x1,y1,e]<>0 then:es=es+1:end if
      next
    mt[x1,y1]=es
    next:next

' ----- step 3
' ----- counts the most used colours in attributes with 4 colours or more
for Y1=0 to 24
  setcaption("step 3: "+str$(y1)+"/24")
  'Locate 41,51 : Print "passo  3 - ";Y1;"/24     "
  for x1=0 to 39
    if mt[x1,y1]>=4 then:
      for e=0 to 15
        if cr[x1,y1,e]>0 then:
          cmu[e]=cmu[e]+1
          end if 
        next
      end if 
    next:next

' ----- step 4
' ----- looks for the most used colour from attributes with 4 colours or more
setcaption("step 4")
'Locate 41,51 : Print "passo  4               "
curc=15:cnt=0
for e=15 to 0 step -1
  If cmu[e]>cnt then: 
    cnt=cmu[e]:curc=e
    end if
  next

' ----- step 5
' ----- sets index 0 from each attribute with most used colour in attribute with 4 colours or more
for y1=0 to 24
  setcaption("step 5: "+str$(y1)+"/24")
  'Locate 41,51 : Print "passo  5 - ";Y1;"/24     "
  for x1=0 to 39
    for g=0 to 3
      ag[x1,y1,g]=16
      next
    ag[x1,y1,0]=curc:cr[x1,y1,curc]=0
    next:next

' ----- step 6
' ----- sets index from 1 to 3 from each attribute with remaining colours
for y1=0 to 24
  setcaption("step 6: "+str$(y1)+"/24")
  'Locate 41,51 : Print "passo  6 - ";Y1;"/24     "
  for x1=0 to 39
    for g=1 to 3
      mx=0:ct=0
      for e=0 to 15
        if cr[x1,y1,e]>mx then: 
          ct=e:mx=cr[x1,y1,e]
          end if 
        next
      cr[x1,y1,ct]=0 :ag[x1,y1,g]=ct
      next:next:next

' ----- step 7
' ----- cleans value 16 generated from step 5 (becomes background0)
for y1=0 to 24
  setcaption("step 7: "+str$(y1)+"/24")
  'Locate 41,51 : Print "passo  7 - ";Y1;"/24     "
  for x1=0 to 39
    for g=1 to 3
      if ag[x1,y1,g]>15 then: 
        ag[x1,y1,g]=ag[0,0,0]
        end if 
      next:next:next

' ----- step 8
' ----- shows the colours being used
ink (colourid2[ag[0,0,0]]):bar(0,200,319,399)
'Ink AG(0,0,0) : Bar 320,0 to 639,199
for y1=0 to 24
  setcaption("step 8: "+str$(y1)+"/24")
  'Locate 41,51 : Print "passo  8 - ";Y1;"/24     "
  for x1=0 to 39
    for e=1 to 3
      ink (colourid2[ag[x1,y1,e]])
      'Ink AG(X1,Y1,E)
        px=320+(x1*8)+1:py=(y1*8)+((e-1)*2)+1
      bar(px,py,px+5,py+1)
      'Bar PX,PY to PX+5,PY+1
      next:next:next

' ----- step 9
' ----- shows the picture about to be saved, and creates the picture of the final binary file
ink (colourid2[ag[0,0,0]]):bar(0,200,319,399)
'Ink AG(0,0,0) : Bar 0,200 to 319,399
for y1=0 to 24
  setcaption("step 9: "+str$(y1)+"/24")
  'Locate 41,51 : Print "passo  9 - ";Y1;"/24     "
  for x1=0 to 39
    for e=0 to 3:kv[e]=iklv[ag[x1,y1,e]]:next
    for y2=0 to 7
      vac=0
      for x2=0 to 3
        x=(x1*4)+x2:y=(y1*8)+y2


        '????? bug below
        'kvv=iklv(point((x*2),y))

        '--- will this work?
        u2=point((x*2),y)
        u=0:dis=1000
        for i=0 to 15
          qq=colourid[i]
          blv=qq mod 16:qq=int(qq/16)
          glv=qq mod 16:qq=int(qq/16)
          rlv=qq mod 16
          qq=u2
          blv2=int(qq/16) mod 16:qq=int(qq/256)
          glv2=int(qq/16) mod 16:qq=int(qq/256)
          rlv2=int(qq/16) mod 16
          bdist=abs(blv-blv2)
          gdist=abs(glv-glv2)
          rdist=abs(rlv-rlv2)
          rgbdist=sqr((rdist^2)+(gdist^2)+(bdist^2))
          if rgbdist<dis then:dis=rgbdist:u=i:end if
          next
        kvv=iklv[u]

        diff=1000:vap=0
        for e=0 to 3
          if diff>(abs(kvv-kv[e])) then:
            vap=e:diff=(abs(kvv-kv[e]))       
            end if
          next

        ink(colourid2[ag[x1,y1,vap]]):dot((x*2),y+200):dot((x*2)+1,y+200)
        ink(colourid2[vap]):dot((x*2)+320,y+200) : dot((x*2)+321,y+200)
        vac=vac+(vap*(4^(3-x2)))
        next
      adrp=0+2+y2+(x1*8)+(y1*320)
      pke[adrp]=vac
      next:next:next

' ----- step 10
' ----- create binary from attributes
for y1=0 to 24
  setcaption("step 10: "+str$(y1)+"/24")
  'locate 41,51 : Print "passo 10 - ";Y1;"/24     "

  for x1=0 to 39
    adrp=0+x1+(y1*40)
    pke[adrp+8002]=((ag[x1,y1,1])*16)+ag[x1,y1,2]
    pke[adrp+9018]=ag[x1,y1,3]
    next:next
  pke[0+9002]=0
  pke[0+9003]=ag[0,0,0]
  pke[0+0]=0
  pke[0+1]=32

' ----- step 10
' ----- saves the final binary
setcaption("step 10: saving...")
'Bsave Fsel$('*.mpic','*.mpic','*.mpic'),Start(4) to Start(4)+10018
open finp$+".mpic" for output as #1
  for i=0 to 9009
    writebyte(1,pke[i])
    next
  close #1

grab (1,0,200,320,200):saveimage(finp$+"_.bmp",1)

'- this line below runs on Linux with Imagemagick installed
shell("convert "+finp$+"_.bmp"+" "+finp$+"_.png"):shell("rm "+finp$+"_.bmp")

setcaption("ready!")
waitkey




